home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / DEC / DI9512AC / example.pas < prev    next >
Pascal/Delphi Source File  |  1995-07-31  |  12KB  |  486 lines
  1. unit Example;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Classes,
  7.   acStream, acList;
  8.  
  9.  
  10. type
  11.  
  12.   { TOptions is used to store application options }
  13.   TOptions = class(TacStreamable)
  14.   private
  15.     FLogResources : Boolean;
  16.     FLogMemory    : Boolean;
  17.     FLogDisk      : Boolean;
  18.   protected
  19.     { TPersistent overrides }
  20.     procedure AssignTo(Dest: TPersistent); override;
  21.     { TEzacStreamable overrides }
  22.     procedure InitFields; override;
  23.     procedure SaveToStream(Stream: TacObjStream); override;
  24.     procedure ReadFromStream(Stream: TacObjStream); override;
  25.   public
  26.     { Properties }
  27.     property LogResources: Boolean
  28.              read FLogResources
  29.              write FLogResources;
  30.     property LogMemory: Boolean
  31.              read FLogMemory
  32.              write FLogMemory;
  33.     property LogDisk: Boolean
  34.              read FLogDisk
  35.              write FLogDisk;
  36.   end;
  37.  
  38.  
  39.   { TLogItem is the base class for log entries. }
  40.   TLogItem = class(TacStreamable)
  41.   private
  42.     FTimeStamp : TDateTime;  { Time of log snapshot }
  43.   protected
  44.     { TPersistent overrides }
  45.     procedure AssignTo(Dest: TPersistent); override;
  46.     { TEzStreamable overrides }
  47.     procedure InitFields; override;
  48.     function  GetAsString: string; override;
  49.     procedure SaveToStream(Stream: TacObjStream); override;
  50.     procedure ReadFromStream(Stream: TacObjStream); override;
  51.   public
  52.     { Properties }
  53.     property  TimeStamp: TDateTime
  54.               read FTimeStamp;
  55.   end;
  56.  
  57.   { TResourceLogItem handles resource tracking log entries. }
  58.   TResourceLogItem = class(TLogItem)
  59.   private
  60.     FSysPctFree  : Word;  { Percentage of free system resources }
  61.     FGdiPctFree  : Word;  { Percentage of free GDI resources }
  62.     FUserPctFree : Word;  { Percentage of free user resources }
  63.     function  GetMinimum: Word;
  64.   protected
  65.     { TPersistent overrides }
  66.     procedure AssignTo(Dest: TPersistent); override;
  67.     { TacStreamable overrides }
  68.     procedure InitFields; override;
  69.     function  GetAsString: String; override;
  70.     procedure SaveToStream(Stream: TacObjStream); override;
  71.     procedure ReadFromStream(Stream: TacObjStream); override;
  72.   public
  73.     { Properties }
  74.     property  System: Word
  75.               read FSysPctFree;
  76.     property  User: Word
  77.               read FUserPctFree;
  78.     property  Gdi: Word
  79.               read FGdiPctFree;
  80.     property  Minimum: Word
  81.               read GetMinimum;
  82.   end;
  83.  
  84.   { TMemoryLogItem handles memory usage log entries. }
  85.   TMemoryLogItem = class(TLogItem)
  86.   private
  87.     FFreeSpace    : LongInt;  { Amount of free memory (KB) }
  88.     FLargestBlock : LongInt;  { Size of largest available block (KB) }
  89.   protected
  90.     { TPersistent overrides }
  91.     procedure AssignTo(Dest: TPersistent); override;
  92.     { TacStreamable overrides }
  93.     procedure InitFields; override;
  94.     function  GetAsString: string; override;
  95.     procedure SaveToStream(Stream: TacObjStream); override;
  96.     procedure ReadFromStream(Stream: TacObjStream); override;
  97.   public
  98.     { Properties }
  99.     property  FreeSpace: LongInt
  100.               read FFreeSpace;
  101.     property  LargestBlock: LongInt
  102.               read FLargestBlock;
  103.   end;
  104.  
  105.   { TDiskLogItem handles disk usage tracking log entries. }
  106.   TDiskLogItem = class(TLogItem)
  107.   private
  108.     FFreeSpace : LongInt;  { Total amount fo free fixed disk space (MB) }
  109.     function  GetTotalFreeDiskSpace: LongInt;
  110.   protected
  111.     { TPersistent overrides }
  112.     procedure AssignTo(Dest: TPersistent); override;
  113.     { TacStreamable overrides }
  114.     procedure InitFields; override;
  115.     function  GetAsString: string; override;
  116.     procedure SaveToStream(Stream: TacObjStream); override;
  117.     procedure ReadFromStream(Stream: TacObjStream); override;
  118.   public
  119.     { Properties }
  120.     property  FreeSpace: LongInt
  121.               read FFreeSpace;
  122.   end;
  123.  
  124.   { TLog is the list of log entries }
  125.   TLog = class(TacObjStringList)
  126.   private
  127.     function  GetLogItem(const Idx: TacObjListIndex): TLogItem;
  128.   public
  129.     { For easier item access }
  130.     property Items[const Idx: TacObjListIndex]: TLogItem
  131.              read GetLogItem; default;
  132.   end;
  133.  
  134.   { TLogStream represents the log data file }
  135.   TSignature = String[6];
  136.   TLogStream = class(TacFileObjStream)
  137.   private
  138.     FSignature : TSignature;
  139.   protected
  140.     procedure ReadHeader; override;
  141.     procedure SaveHeader; override;
  142.   end;
  143.  
  144.  
  145. implementation
  146.  
  147. uses
  148.   WinTypes, WinProcs;
  149.  
  150.  
  151. const
  152.   LOG_SIGNATURE : TSignature = 'LOGDAT';
  153.  
  154.  
  155. { TOptions }
  156.  
  157.  
  158. procedure TOptions.AssignTo(Dest: TPersistent);
  159. begin
  160.   if ( (Dest is TOptions) and (Self is Dest.ClassType) ) then
  161.     begin
  162.     with  Dest as TOptions  do
  163.       begin
  164.       FLogResources := self.FLogResources;
  165.       FLogMemory    := self.FLogMemory;
  166.       FLogDisk      := self.FLogDisk;
  167.       end;
  168.     end
  169.   else
  170.     begin
  171.     inherited AssignTo(Dest);
  172.     end;
  173. end;
  174.  
  175.  
  176. procedure TOptions.InitFields;
  177. begin
  178.   inherited InitFields;
  179.   FLogResources := False;
  180.   FLogMemory    := False;
  181.   FLogDisk      := False;
  182. end;
  183.  
  184.  
  185. procedure TOptions.SaveToStream(Stream: TacObjStream);
  186. begin
  187.   Stream.SaveBuffer(FLogResources, SizeOf(FLogResources));
  188.   Stream.SaveBuffer(FLogMemory,    SizeOf(FLogMemory));
  189.   Stream.SaveBuffer(FLogDisk,      SizeOf(FLogDisk));
  190. end;
  191.  
  192.  
  193. procedure TOptions.ReadFromStream(Stream: TacObjStream);
  194. begin
  195.   Stream.ReadBuffer(FLogResources, SizeOf(FLogResources));
  196.   Stream.ReadBuffer(FLogMemory,    SizeOf(FLogMemory));
  197.   Stream.ReadBuffer(FLogDisk,      SizeOf(FLogDisk));
  198. end;
  199.  
  200. { TLogItem }
  201.  
  202.  
  203. procedure TLogItem.AssignTo(Dest: TPersistent);
  204. begin
  205.   if ( (Dest is TLogItem) and (Self is Dest.ClassType) ) then
  206.     begin
  207.     with  Dest as TLogItem  do
  208.       begin
  209.       FTimeStamp := self.FTimeStamp;
  210.       end;
  211.     end
  212.   else
  213.     begin
  214.     inherited AssignTo(Dest);
  215.     end;
  216. end;
  217.  
  218. procedure TLogItem.InitFields;
  219. begin
  220.   inherited InitFields;
  221.   FTimeStamp := Now;
  222. end;
  223.  
  224. procedure TLogItem.SaveToStream(Stream: TacObjStream);
  225. begin
  226.   Stream.SaveBuffer(FTimeStamp, SizeOf(FTimeStamp));
  227. end;
  228.  
  229. procedure TLogItem.ReadFromStream(Stream: TacObjStream);
  230. begin
  231.   Stream.ReadBuffer(FTimeStamp, SizeOf(FTimeStamp));
  232. end;
  233.  
  234. function  TLogItem.GetAsString: String;
  235. begin
  236.   Result := FormatDateTime('mm/dd/yy hh:mm:ss', TimeStamp);
  237. end;
  238.  
  239.  
  240. { TResourceLogItem }
  241.  
  242.  
  243. function  TResourceLogItem.GetMinimum: Word;
  244. begin
  245.   Result := System;
  246.   if ( GDI < Result )  then Result := GDI;
  247.   if ( User < Result ) then Result := User;
  248. end;
  249.  
  250. procedure TResourceLogItem.AssignTo(Dest: TPersistent);
  251. begin
  252.   if ( (Dest is TResourceLogItem) and (Self is Dest.ClassType) ) then
  253.     begin
  254.     inherited AssignTo(TLogItem(Dest));
  255.     with  Dest as TResourceLogItem  do
  256.       begin
  257.       FSysPctFree  := self.FSysPctFree;
  258.       FGdiPctFree  := self.FGdiPctFree;
  259.       FUserPctFree := self.FUserPctFree;
  260.       end;
  261.     end
  262.   else
  263.     begin
  264.     inherited AssignTo(Dest);
  265.     end;
  266. end;
  267.  
  268. procedure TResourceLogItem.InitFields;
  269. begin
  270.   { Allow TLogItem to initialize }
  271.   inherited InitFields;
  272.  
  273.   FSysPctFree  := GetFreeSystemResources(GFSR_SystemResources);
  274.   FGdiPctFree  := GetFreeSystemResources(GFSR_GDIResources);
  275.   FUserPctFree := GetFreeSystemResources(GFSR_UserResources);
  276. end;
  277.  
  278. procedure TResourceLogItem.SaveToStream(Stream: TacObjStream);
  279. begin
  280.   { Allow TLogItem chance to save }
  281.   inherited SaveToStream(Stream);
  282.  
  283.   Stream.SaveBuffer(FSysPctFree,  SizeOf(FSysPctFree));
  284.   Stream.SaveBuffer(FGdiPctFree,  SizeOf(FGdiPctFree));
  285.   Stream.SaveBuffer(FUserPctFree, SizeOf(FUserPctFree));
  286. end;
  287.  
  288. procedure TResourceLogItem.ReadFromStream(Stream: TacObjStream);
  289. begin
  290.   { Allow TLogItem chance to read }
  291.   inherited ReadFromStream(Stream);
  292.  
  293.   Stream.ReadBuffer(FSysPctFree,  SizeOf(FSysPctFree));
  294.   Stream.ReadBuffer(FGdiPctFree,  SizeOf(FGdiPctFree));
  295.   Stream.ReadBuffer(FUserPctFree, SizeOf(FUserPctFree));
  296. end;
  297.  
  298. function  TResourceLogItem.GetAsString: String;
  299. begin
  300.   { Get Timestamp string from TLogItem }
  301.   Result := inherited GetAsString;
  302.  
  303.   { Append resource descriptions }
  304.   AppendStr(Result, '  Rsrc